home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 24 / CU Amiga Magazine's Super CD-ROM 24 (1998)(EMAP Images)(GB)(Track 1 of 2)[!][issue 1998-07].iso / CUCD / Programming / SWI / source / lib / toolkit.pl < prev    next >
Encoding:
Text File  |  1992-05-26  |  1.9 KB  |  87 lines
  1. /*  $Id: toolkit.pl,v 1.1.1.1 1992/05/26 11:51:38 jan Exp $
  2.  
  3.     Copyright (c) 1990 Jan Wielemaker. All rights reserved.
  4.     jan@swi.psy.uva.nl
  5.  
  6.     Purpose: provide some nice user utilities
  7. */
  8.  
  9. :- module(toolkit,
  10.     [ lp/1
  11.     , llp/1
  12.     , lp_predicate/1
  13.     ]).
  14.     
  15. :- use_module(library(am_match),
  16.     [ am_compile/1
  17.     , am_match/1
  18.     ]).
  19.  
  20. :- module_transparent
  21.     lp/1, 
  22.     llp/1, 
  23.     lp_matching_predicates/2, 
  24.     lp_predicate/1.
  25.  
  26. :- op(900, fy, [lp, llp]).
  27.  
  28. lp(Expression) :-
  29.     lp_matching_predicates(Expression, Predicates), 
  30.     lp_print_predicates(Predicates, 76).
  31.  
  32. llp(Expression) :-
  33.     lp_matching_predicates(Expression, Predicates), 
  34.     checklist(listing, Predicates).
  35.  
  36. lp_matching_predicates(Expression, Predicates) :-
  37.     am_compile(Expression), !, 
  38.     bagof(Pred, lp_predicate(Pred), Predicates), !.
  39. lp_matching_predicates(_, []).
  40.  
  41. lp_predicate(Func/Ar) :-
  42.     current_predicate(Func, Term), 
  43.     am_match(Func), 
  44.     functor(Term, Func, Ar).
  45.  
  46. /*  show a list of predicates on the terminal.
  47. */
  48.  
  49. lp_print_predicates(RawList, Width) :-
  50.     msort(RawList, List), 
  51.     lp_widest_predicate(List, WA), 
  52.     NC is Width // (WA+2),             % Number of collums
  53.     WC is Width // NC,             % Width of collums
  54.     lp_list_predicates(List, NC, WC, 0), !.
  55.  
  56. lp_list_predicates([], _, _, 0) :- !.
  57. lp_list_predicates([], _, _, _) :- nl, !.
  58. lp_list_predicates([F/A|Tail], NC, WC, NC_1) :-
  59.     succ(NC_1, NC), 
  60.     write(F), write('/'), write(A), nl, 
  61.     lp_list_predicates(Tail, NC, WC, 0).
  62. lp_list_predicates([H|Tail], NC, WC, C) :-
  63.     lp_write_left(H, WC), 
  64.     succ(C, NewC), 
  65.     lp_list_predicates(Tail, NC, WC, NewC), !.
  66.  
  67. lp_write_left(F/A, Width) :-
  68.     write(F), write('/'), write(A), 
  69.     name(F, LF), 
  70.     length(LF, WF), 
  71.     name(A, LA), 
  72.     length(LA, WA), 
  73.     tab(Width-WF-WA), !.
  74.  
  75. lp_widest_predicate([], 0).
  76. lp_widest_predicate([F/A|T], W) :-
  77.     name(F, LF), 
  78.     length(LF, WF), 
  79.     name(A, LA), 
  80.     length(LA, WA), 
  81.     WH is WF + WA + 1, 
  82.     lp_widest_predicate(T, WT), 
  83.     lp_biggest(WH, WT, W), !.
  84.  
  85. lp_biggest(A, B, A) :- A >= B, !.
  86. lp_biggest(_, B, B).
  87.